home *** CD-ROM | disk | FTP | other *** search
- REM MAPFIX.bas PROGRAM. SEE EXPLAINATION BELOW
- REM
- Ver$ = "6.0": REM This version properly displays cursor loc in E long
- REM and recovers from DISK NOT READY ERROR
- MaxNumMAPS = 120'was 99 Current maximum number of maps loaded by APRS
- MaxNumPoints = 1500 'was 1000
- MaxNumLABELS = 99 'was 99
- MaxNumLines = 900
- REM $DYNAMIC
- GOTO BEGIN
-
- Info: COLOR 15, 4: CLS
- PRINT " MAPFIX.bas VERSION "; Ver$; " PROGRAM FOR FIXING APRS MAPS": PRINT
- PRINT " This program is always evolving. Check the version number and HELP screen to"
- PRINT " see whats new."
- PRINT
- PRINT " MAPFIX can build a map from the 2,000,000:1 USGS CD ROM, BUT NOT EASILY! For"
- PRINT " a 50 mile map, 5 MBytes of redundant USGS data must be filtered down to the"
- PRINT " nominal 15K APRS size for the same area and same detail! The final steps are"
- PRINT " all manual and take almost as long as developing an APRS map from scratch!"
- PRINT
- PRINT " CAUTION, THIS PROGRAM IS NOT PERFECT... KEEP BACKUPS! Do a little at a time!"
- PRINT
- PRINT " Although MAPFIX has commands to make map modifications easier, a text EDITOR is"
- PRINT " still useful for whole scale rearranging of points and features in a map file. "
- PRINT
- PRINT " MAPFIX uses two cursors. The normal yellow APRS cursor, and a White MapPoint"
- PRINT " which will be the next point to be processed. ALT Keys allow you to MOVE the"
- PRINT " MapPoint to the cursor, ADD a new point at the cursor, or DELETE the MapPoint."
- PRINT " The G command will GO your cursor and screen to the MapPoint and conversly,"
- PRINT " the Find command will move the MapPoint to the feature nearest the cursor."
- PRINT
- PRINT " MAPFIX.bas shows you Deg/Min, Decimal, and APRS values of the cursor position."
- PRINT
- PRINT " ALSO NOTE THAT THE LIMITS IN APRS ARE 1500 POINTS, 99 FEATURES, and 99 LABELS!"
- PRINT " If you need more points, features or labels, begin another map.";
- LOCATE 25, 1: PRINT " HIT ANY KEY to continue...";
- GOSUB GetChar: SOUND 800, 3
-
- Info2: COLOR 15, 8: CLS
- PRINT " PAGE 2 INSTRUCTIONS: More about new features in version "; Ver$
- PRINT
- PRINT " With MAPFIX.bas, you can modify features by moving, adding or deleting POINTS"
- PRINT " or Killing whole features, ie: roads, rivers, borders, etc. The TRIM command"
- PRINT " will remove all points outside of the white box showing the MAP size formed"
- PRINT " with the alt-Center and alt-Range commands."
- PRINT
- PRINT " If the MapPointer and FeatureName get out of sequence, the RESET command may"
- PRINT " fix them, but you should save the file immediately and check it with an editor."
- PRINT
- PRINT " I find the capability to delete points very useful when making larger area"
- PRINT " maps from several smaller detail maps. First, I run MAPCNVRT.bas to convert"
- PRINT " all of the smaller maps to new temporary files with the new origin of the new"
- PRINT " larger map. Then I use the KILL command in MAPFIX to eliminate all minor "
- PRINT " roads, features and labels and then the DELETE POINT command to remove all"
- PRINT " inconsequential minor points from the roads that will not be needed"
- PRINT " at the larger scale. Then I use the editor to combine all of the points and"
- PRINT " labels into the new file."
- PRINT
- PRINT " A new MAPLIST command shows your MAPLIST.map file; and the OTHER MAPS command"
- PRINT " shows all MAP borders so you can see how your new map fits in. You may use F3"
- PRINT " and F4 keys to select smaller or larger map borders to draw."
- PRINT
- LOCATE 25, 1: PRINT " HIT ANY KEY to continue...";
- GOSUB GetChar: SOUND 800, 3
-
- Info3: COLOR 15, 3: CLS
- PRINT " PAGE 3 INSTRUCTIONS: Using GPS Track History Files to draw maps!"
- PRINT
- PRINT " To aid in creating accurate maps, W7KKE in California added routines to MAPFIX"
- PRINT " so that you can overlay a Track History file onto the map you are constructing."
- PRINT " This is an excellent tool for correcting your maps to real GPS data."
- PRINT ""
- PRINT " After you have loaded your map, type alt-G (GPS Track History') and enter the"
- PRINT " history filename. This will overlay the track history file. You may then"
- PRINT " use the normal MAPFIX.bas routines to move map segments and add so that the"
- PRINT " map will agree with the GPS data contained in the track history file. This"
- PRINT " is especially useful with the history files saved by a laptop during mobile"
- PRINT " GPS operations."
- PRINT
- PRINT " CAUTION: Since GPS data is only accurate to 100 yards due to the effects of"
- PRINT " Selective Availability, I would avoid using GPS data explicitely below about"
- PRINT " the 2 mile range. For this reason, I make the size of the GPS positions "
- PRINT " expand below the 2 mile range to roughly approximate the size of the 100 yard"
- PRINT " error circle."
- PRINT
- PRINT " Also note that you can now START a NEW map from scratch, without using the"
- PRINT " text editor to enter the initial configuration data. Just type NEW instread "
- PRINT " of a MAPfilename when starting up the program."
- LOCATE 25, 1: PRINT " HIT ANY KEY to continue...";
- GOSUB GetChar: SOUND 800, 3
-
-
- Info4: COLOR 15, 7: CLS
- PRINT " PAGE 4 INSTRUCTIONS FOR USING A DIGITIZER:": PRINT
- PRINT " In version 3.07B, MAPFIX.bas can now interface to a digitizer tablet or table"
- PRINT " so that maps can be drawn directly from paper maps. These routines were"
- PRINT " developed by W7KKE and added to MAPFIX.bas in December 1993."
- PRINT
- PRINT " To use a digitizer, first you must hit the ALT-O command to open the COMM"
- PRINT " PORT for the digitizer. This command also lets you test the digitizer while"
- PRINT " testing the alignment of the map on the digitizer surface. It then prompts"
- PRINT " you to identify the upper left and lower right corners of the map, in order"
- PRINT " to calibrate the digitizer to the latitude, longitude and scale of the map."
- PRINT
- PRINT " From this point on, the button on the digitizer mouse is almost identical to"
- PRINT " the ALT-A command for ADDing a point. To start a new map feature, however,"
- PRINT " for the digitizer, you DO NOT use the ALT-N NEW command, but you should use"
- PRINT " the ALT-B BEGIN command. For More information, see the README.DIG file."
- PRINT
- PRINT " To speed up the map drawing during editing, I no longer erase and re-draw"
- PRINT " the entire map with each new point. I simply draw just the new line segment."
- PRINT " Sometimes, especially when you move, or add a line, this leaves an old line"
- PRINT " segment, where there actually is no longer a line. You can always celan up"
- PRINT " the map by just hitting the space bar to force a new map..."
- PRINT
-
-
- Display$ = "UNKnown"
- RETURN
-
- GetChar: a$ = "": DO UNTIL a$ <> "": a$ = INKEY$: LOOP: RETURN
-
- BEGIN: GOSUB Info:
- PRINT " HIT ANY KEY to proceed onto the HELP screen...";
- GOSUB GetChar
-
- DIM x%(5 * MaxNumPoints), y%(5 * MaxNumPoints)
- REM MAP coordinates **** THESE ARE BIGGER THAN APRS ***
- DIM LN$(MaxNumLines) ' (no limit in APRS) **** SO YOU CAN MANIPULATE BIG MAPS
- nn = 2 * MaxNumLABELS
- DIM ML$(nn), MLa(nn), MLo(nn), MLr(nn) 'Map Labels, lengths and coordinates
- nn = 2 * MaxNumMAPS
- DIM MapName$(nn), LATcen(nn), LONcen(nn), MapMax(nn), Comment$(nn)
- RdsOn = -1: Labls = -1: Tags = -1: KP = 1: Changed = 0: MapSize = 256
- i = 1000
- DIM HLAT(i), HLONG(i)'For lat/longs from big GPS history files
-
- INIT: ON ERROR GOTO ErrorTrap
- ScrnType$ = "EGA": Ycen = 200: Yfactr = 1: YfacTXT = 350 / 350: SCREEN 9
- IF ScrnType$ = "EGA" THEN COLOR 15, 0
- REM ScrnType$ = "CGA": Yfactr=200/400:Ycen = 200*Yfactr: SCREEN 2
- ReDraw = -1
-
- Display$ = "HELP": GOSUB HELP: GOSUB LoadMap
- REM ON ERROR GOTO 0
-
- Main: GOSUB DrwMPaCur
- DO
- GoAgain: Fault = 0
- IF Digitizer THEN
- IF LOC(1) > 9 THEN
- GOSUB GetXY: GOSUB Cursor
- IF Btn <> 3 THEN GOSUB AddPoint
- END IF
- END IF
- a$ = INKEY$
- IF a$ <> "" THEN
- a$ = UCASE$(a$): Key$ = a$
- IF a$ = "S" THEN GOSUB labels
- IF a$ = "L" THEN Labls = NOT Labls
- IF a$ = "T" THEN Tags = NOT Tags
- IF a$ = "F" THEN LnStrt = 0: StrtSrch = 1: GOSUB FindPoint
- IF a$ = CHR$(6) THEN LnStrt = LnPtr: StrtSrch = Z + 1: GOSUB FindPoint
- IF a$ = "G" THEN GOSUB CurToPoint: GOSUB CurDrwMap
- IF a$ = "H" THEN
- IF Display$ <> "HELP" THEN
- GOSUB HELP
- ELSE GOSUB Info
- LOCATE 25, 1: PRINT " H for HELP or SPACE BAR for map..."; : a$ = ""
- END IF
- END IF
- IF a$ = "B" THEN GOSUB BoxPPD
- IF a$ = "U" THEN GOSUB GetUSGS
- IF a$ = "D" THEN GOSUB MapDIR
- IF a$ = "M" THEN GOSUB ListMAPlist
- IF a$ = "O" THEN GOSUB DrwAndShow
- IF a$ = "N" THEN GOSUB NextLine: GOSUB Cursor
- IF a$ = "P" THEN GOSUB Previous: GOSUB Cursor
- IF a$ = "Q" THEN GOSUB QUIT
- IF a$ = "R" THEN Z = 2: LnPtr = 1
- IF a$ = "T" THEN GOSUB Scrunch
- IF a$ = " " THEN Display$ = "MAP": ReDraw = -1: USGS = 0: GOSUB DrwMPaCur
- IF a$ = "+" THEN Z = Z + 1: GOSUB MapPoint ' moves to next map point
- IF a$ = "-" THEN Z = Z - 1: GOSUB MapPoint ' moves backwards
- IF a$ = CHR$(18) THEN ReDraw = NOT ReDraw: GOSUB ReDraw
-
- B$ = "": IF LEN(a$) = 2 THEN B$ = RIGHT$(a$, 1): REM process arrow & special keys
- IF B$ = "I" THEN RS = RS * 2: GOSUB CurDrwMap: REM change scale
- IF B$ = "Q" THEN RS = RS / 2: GOSUB CurDrwMap
- IF B$ = CHR$(132) THEN RS = RS * 8: GOSUB CurDrwMap: REM change scale by factor of 4
- IF B$ = "V" THEN RS = RS / 8: GOSUB CurDrwMap
- IF B$ = "G" THEN GOSUB CurDrwMap 'Home key
- IF a$ = "7" THEN CDX = LONo: CDY = LATo: GOSUB DrwMPaCur 'ShiftHOME
- IF B$ = "O" THEN CDX = LONcen: CDY = LATcen: GOSUB DrwMPaCur 'End Key
- IF B$ = "M" THEN CPX = CPX - 4 / (Sfac): GOSUB Cursor
- IF B$ = "K" THEN CPX = CPX + 4 / (Sfac): GOSUB Cursor
- IF B$ = "H" THEN CPY = CPY + 4 / (Sfac): GOSUB Cursor
- IF B$ = "P" THEN CPY = CPY - 4 / (Sfac): GOSUB Cursor
- REM Here are the special MapFIx routines
- IF B$ = CHR$(30) THEN GOSUB AddPoint 'alt-ADD point
- IF B$ = CHR$(48) AND Digitizer THEN GOSUB NewFeature'alt-BEGIN
- IF B$ = CHR$(34) THEN GOSUB LoadHst 'alt-GPS hstry file
- IF B$ = CHR$(50) THEN GOSUB MakePT: IF ReDraw THEN GOSUB DrawMap 'MOVE point to cursor
- IF B$ = CHR$(32) THEN GOSUB DelPT 'alt-DELete point
- IF B$ = CHR$(38) THEN GOSUB AddLabel 'alt-ADD LABEL
- IF B$ = CHR$(46) THEN GOSUB NewCenter 'alt-CENTER
- IF B$ = CHR$(36) THEN GOSUB Join 'alt-JOIN
- IF B$ = CHR$(37) THEN GOSUB KillF 'alt-KILL Feature
- IF B$ = CHR$(19) THEN GOSUB MapRange 'alt-RANGE
- IF B$ = CHR$(20) THEN GOSUB TRIM 'alt-TRIM
- IF B$ = CHR$(49) THEN GOSUB NewFeature 'alt-NEW Feature
- IF B$ = CHR$(24) THEN GOSUB DigiInit: GOSUB DrawMap'alt-OPEN dgtzr COM
- IF B$ = CHR$(31) THEN GOSUB Scrunch 'alt-SCRUNCH
- IF B$ = CHR$(22) THEN GOSUB GetUSGS 'alt-U
- IF B$ = CHR$(61) THEN 'F3 for smaller Maps
- MapSize = MapSize / 2: IF MapSize < 1 THEN MapSize = 1
- GOSUB ShowMaps
- END IF
- IF B$ = CHR$(62) THEN 'F4 for larger Maps
- MapSize = MapSize * 2: IF MapSize > 1000 THEN MapSize = 1000
- GOSUB DrwAndShow
- END IF
- IF a$ = CHR$(19) THEN GOSUB SaveMap
- IF a$ = CHR$(3) THEN GOSUB ChgColr
-
- IF a$ = "6" THEN CPX = CPX - 20 / (Sfac): GOSUB Cursor'SHIFT Cursor by 4
- IF a$ = "4" THEN CPX = CPX + 20 / (Sfac): GOSUB Cursor
- IF a$ = "8" THEN CPY = CPY + 20 / (Sfac): GOSUB Cursor
- IF a$ = "2" THEN CPY = CPY - 20 / (Sfac): GOSUB Cursor
-
- END IF
- LOOP
- SYSTEM 'you should never get here
-
- ReDraw: LOCATE 1, 30
- IF ReDraw THEN PRINT "REDRAW ENABLED": ELSE PRINT "NO ReDraw... "
- RETURN
-
- QUIT: a$ = "Y"
- IF Changed THEN
- GOSUB BoxLine23
- PRINT "**** MAP HAS BEEN MODIFIED"; Changed; "TIMES BUT NOT SAVED!!! SAVE NOW? (Y)";
- INPUT a$
- IF UCASE$(a$) <> "N" THEN GOSUB SaveMap
- END IF
- SYSTEM
-
- TRIM: GOSUB BoxLine23
- CLS : PRINT "TRIM ALL POINTS AND LABELS OUTSIDE OF MAPRANGE"
- PRINT
- PRINT "This command will remove all points and labels that are outside of the white"
- PRINT "map border. You can change the location of this map border by using"
- PRINT "the CENTER command (alt-C) and by changing the RANGE using alt-R."
- PRINT : PRINT
- PRINT "No map feature will be completely eliminated..."
- PRINT
- PRINT "The first and last point of any FEATURE will be retained, so the"
- PRINT "result will be long single lines for all FEATURES outside the map border."
- PRINT "Use the KILL FEATURE (alt-K) to eliminate those lines and use the MOVE"
- PRINT "command (alt-M) to move any far away points closer to the border."
- PRINT : PRINT
- PRINT "You might consider stopping now and doing a SAVE (ctrl-S) before proceeding."
- PRINT
- PRINT "ALSO, THIS DOES NOT WORK FOR POINTS WITH NEGATIVE VALUES! Be sure your"
- PRINT "selected area is below and to right of ORIGIN. If not, run MAPCNVRT.bas."
- PRINT : PRINT
- INPUT "Are you ready to proceed? (Y/N) (N)"; ans$
- GOSUB DrawMap
- IF UCASE$(ans$) <> "Y" THEN RETURN
- C = 0: LOCATE 23, 1: PRINT "Processing...";
- REM dx and dy are num pix of center of map
- REM bx and by are borders of map based on MapRng
- by = ppdV * MapRng / 60
- bx = by / Lfac
- FOR Z = 1 TO nmp - 4
- IF x%(Z) = 0 THEN Z = Z + 2
- IF x%(Z) > dx + bx OR y%(Z) > dy + by THEN bad = 1 ELSE bad = 0
- IF x%(Z) < dx - bx OR y%(Z) < dy - by THEN bad = 1
- IF bad AND x%(Z - 1) <> 0 AND x%(Z + 1) <> 0 THEN
- GOSUB DelPT: Z = Z - 1
- C = C + 1
- END IF
- NEXT Z
- LOCATE 23, 1: PRINT "Now removing labels...";
- FOR i = 1 TO nml: REM now eliminate all labels outside
- bad = 0: Xm = MapRng / (60 * Lfac): Ym = MapRng / 60
- IF MLo(i) > LONcen + Xm OR MLa(i) > LATcen + Ym THEN bad = 1
- IF MLo(i) < LONcen - Xm OR MLa(i) < LATcen - Ym THEN bad = 1
- IF bad = 1 THEN
- FOR j = i TO nml
- ML$(j) = ML$(j + 1): MLa(j) = MLa(j + 1)
- MLo(j) = MLo(j + 1): MLr(j) = MLr(j + 1)
- NEXT j: nml = nml - 1: PRINT ".";
- END IF
- NEXT i
- GOTO DrawMap
-
-
- FindPoint: CurX = INT(.5 + dx + (CUX - 320) / (KP * Hfac))
- CurY = INT(.5 + dy + (CUY - Ycen) / KP)
-
- GOSUB BoxLine23: PRINT "SEARCHING THROUGH ALL POINTS IN FILE...";
- REM SaveZ = Z: SaveLNptr = LnPtr
- Agn: FOR j = 0 TO 30 ' Go through abt 20 times lookin pt.
- IF j > 10 THEN j = j + 1' first with 0 delta, then bigger
- PRINT ".";
- LnCtr = LnStrt
- FOR i = StrtSrch TO nmp
- IF x%(i) = 0 THEN LnCtr = LnCtr + 1
- IF x%(i) > CurX - j AND x%(i) < CurX + j THEN
- IF y%(i) > CurY - j AND y%(i) < CurY + j THEN
- Z = i: LnPtr = LnCtr: GOSUB CurToPoint
- j = 99: i = nmp
- END IF
- END IF
- NEXT i:
- NEXT j
- IF j < 99 AND Key$ = CHR$(6) THEN StrtSrch = 2: LnCtr = 1: Key$ = "F": GOTO Agn
- IF j < 99 THEN PRINT "None found!": RETURN
- GOSUB MapPoint: SavClr = 0: RETURN
-
- NewFeature: LOCATE 24, 1: PRINT SPACE$(27); : GOSUB BoxLine23
- INPUT "Enter reference name for new feature"; a$
- IF a$ = "" THEN RETURN
- GOSUB Rainbow: IF abort THEN RETURN
- GOSUB BeginF
- GOSUB BoxLine23: LOCATE 25, 1: PRINT SPACE$(80); : LOCATE 25, 1
- IF RIGHT$(Key$, 1) = CHR$(48) THEN
- PRINT "NOW USE DIGITIZER TO ADD NEW POINTS TO THIS FEATURE...";
- GOSUB GetXY: GOSUB Cursor
- ELSE
- PRINT "NOW MOVE CURSOR AND USE ALT-A TO ADD POINTS TO THIS NEW FEATURE...";
- END IF
- GOSUB MakePT
- RETURN
-
- Rainbow: LOCATE 25, 1
- FOR i = 0 TO 14
- PRINT RIGHT$(" " + MID$(STR$(i + 1), 2), 2); " ";
- LINE (16 + i * 40, 335 * YfacTXT)-(40 + i * 40, 349 * YfacTXT), i + 1, BF
- NEXT i
- GOSUB BoxLine23
- INPUT "Select color (4,7,10-Hwys 11-Water 12-Hwy 13-Spcl 14-City)"; B$
- SavClr = VAL(B$): IF SavClr > 15 OR SavClr < 1 THEN abort = -1 ELSE abort = 0
- RETURN
-
-
- BeginF: x%(nmp) = 0: y%(nmp) = SavClr 'Store feature color 0,c
- LN$(LNi + 1) = LN$(LNi): LnPtr = LNi'Bump up present LN$ comment
- LN$(LNi) = a$: LNi = LNi + 1'Store feature name
- nmp = nmp + 1: Z = nmp
- nmp = nmp + 1: x%(nmp) = 0: y%(nmp) = 0'nmp points to ending 0,0
- RETURN
-
- CanclF: nmp = nmp - 2: Z = Kz
- LNi = LNi - 1: LN$(LNi) = LN$(LNi + 1): RETURN
-
- NewCenter: LATcen = CPY: LONcen = CPX: Changed = Changed + 1: GOTO CurDrwMap
-
- MapRange: GOSUB BoxLine23: INPUT "Enter map range"; a$
- IF VAL(a$) <> 0 THEN MapRng = VAL(a$)
- Changed = Changed + 1: GOTO DrwMPaCur
-
- AddPoint: x% = dx + (CUX - 320) / (KP * Hfac)
- IF x% = 0 THEN BEEP: PRINT "X=0!!!": RETURN
- nmp = nmp + 1: Z = Z + 1
- FOR i = nmp TO Z STEP -1
- x%(i) = x%(i - 1): y%(i) = y%(i - 1)
- NEXT
- GOSUB MakePT
- IF SavClr = 0 AND ReDraw THEN GOTO DrawMap
- s = Z - 1: LineColor = SavClr: GOTO DP
-
- MakePT: x%(Z) = dx + (CUX - 320) / (KP * Hfac)
- y%(Z) = dy + (CUY - Ycen) / KP
- Changed = Changed + 1
- GOTO MapPoint
-
- CurToPoint:
- CPX = CDX - (x%(Z) - dx) / ppdV
- CPY = CDY - (y%(Z) - dy) / (ppdV * Yfactr)
- GOTO Cursor
-
- DelPT: GOSUB DelZ
- REM if 1st pt, it stays as 1st pt
-
- IF x%(Z) = 0 THEN Z = Z - 1: REM if end pt, it stays as end
- IF x%(Z + 1) = 0 AND x%(Z - 1) = 0 THEN 'It is LAST point
- GOSUB Kline: LnPtr = LnPtr - 1 'So Kill Line
- GOSUB DelZ 'And Kiil it
- Z = Z - 1: GOSUB DelZ: Z = Z - 1 'Kill 0,color
- END IF 'and -1 to end point
- IF B$ = CHR$(32) AND ReDraw THEN GOSUB DrawMap ELSE GOSUB MapPoint
- RETURN
-
- DelZ: nmp = nmp - 1
- FOR i = Z TO nmp
- x%(i) = x%(i + 1): y%(i) = y%(i + 1)
- NEXT: Changed = Changed + 1: RETURN
-
- NextLine: IF Z >= nmp - 1 THEN Z = nmp - 1: BEEP: RETURN
- DO UNTIL x%(Z) = 0: Z = Z + 1: LOOP
- IF Z < nmp - 1 THEN Z = Z + 1: LnPtr = LnPtr + 1
- SavClr = 0: GOTO MapPoint
- Previous: DO UNTIL Z = 1 OR x%(Z) = 0: Z = Z - 1: LOOP
- IF Z > 3 THEN Z = Z - 1: LnPtr = LnPtr - 1
- SavClr = 0: GOTO MapPoint
-
- KillF: GOSUB Find1st: REM Stop at Beginning (0) point of the feature to kill
- ni = Bi + 1' Now scan for next feature
- DO UNTIL x%(ni) = 0: ni = ni + 1: LOOP
- REM now move down rest of array to fill
- DO UNTIL ni = nmp + 1
- x%(Bi) = x%(ni): y%(Bi) = y%(ni)
- Bi = Bi + 1: ni = ni + 1
- LOOP
- nmp = nmp - (ni - Bi): y%(nmp) = 0
- GOSUB Kline
- GOTO DrawMap
-
- Find1st: Bi = Z: Changed = Changed + 1
- DO UNTIL x%(Bi) = 0: Bi = Bi - 1: LOOP: Z = Bi + 1
- RETURN
-
- ChgColr: GOSUB Find1st: GOSUB Rainbow: IF abort THEN RETURN
- y%(Bi) = SavClr: RETURN
-
-
- Kline: FOR i = LnPtr TO LNi
- LN$(i) = LN$(i + 1)
- NEXT i
- LNi = LNi - 1
- RETURN
-
- MapPoint:
- IF Z < 2 THEN Z = 2: LnPtr = 1: BEEP: SavClr = 0
- IF Z > nmp - 1 THEN Z = Z - 1: BEEP: SavClr = 0
- IF x%(Z) = 0 THEN
- IF a$ = "-" THEN
- LnPtr = LnPtr - 1: Z = Z - 1
- ELSE LnPtr = LnPtr + 1: Z = Z + 1
- END IF: SavClr = 0
- END IF
- IF LnPtr < 0 THEN LnPtr = 0
- IF Display$ = "MAP" THEN
- LOCATE 22, 1
- PRINT "Fture#"; LnPtr; TAB(12); LEFT$(LN$(LnPtr) + " ", 12);
- END IF
- DrwMpPt: IF Display$ <> "MAP" THEN RETURN
- CIRCLE (Xtest, Ytest), 10, 0 'Erase old circle
- Xtest = 320 + KP * (x%(Z) - dx) * Hfac
- Ytest = Ycen + KP * (y%(Z) - dy) * Yfactr
- CIRCLE (Xtest, Ytest), 10, 15
-
- LOCATE 23, 1: PRINT "MapPt#"; Z;
- IF Z > 999 THEN PRINT TAB(13); "val:"; ELSE PRINT TAB(12); "vals:";
- PRINT TAB(17); x%(Z); TAB(23); y%(Z)
- RETURN
-
- AddLabel: nml = nml + 1
- MLa(nml) = CPY: MLo(nml) = CPX
- GOSUB BoxLine23: INPUT "Enter Label Name"; a$: ML$(nml) = a$
- GOSUB BoxLine23: INPUT "Begin displaying label at what range?"; a$
- a = VAL(a$): IF a <> 0 THEN MLr(nml) = a: ELSE MLr(nml) = 2048
- Changed = Changed + 1: GOTO labels
-
- BoxLine23: LOCATE 23, 1: PRINT SPACE$(80); : LOCATE 23, 1: RETURN
-
- ErrorTrap: Fault = ERR: 'Error handling routine
- IF ERR = 57 THEN PRINT " I/O-error-User-logoff"; : RESUME
- IF ERR = 69 THEN PRINT " Comm-buffer-overflow"; : RESUME
- IF ERR = 53 THEN PRINT " file-"; F$; "-not-found": CLOSE : RESUME NEXT
- IF ERR = 62 THEN RESUME NEXT
- IF ERR = 52 THEN RESUME NEXT
- IF ERR = 55 THEN RESUME NEXT
- IF ERR = 2 THEN PRINT "SYNTAX-error"
- IF ERR = 70 THEN PRINT " WRITE PROTECTED!...": RESUME NEXT
- IF ERR = 76 THEN PRINT "Wrong Path!": RESUME NEXT
- IF ERR = 71 THEN PRINT "no disk!": RESUME NEXT
- RESET
- PRINT : PRINT "Error beyond repair. Number = "; ERR;
- INPUT "Hit RETURN to return to DOS"; a$
- SYSTEM
-
- MapDIR: CLS : PRINT "MAP FILES DIRECTORY": PRINT
- PRINT "To display MAP files, please enter the path to your xxxxxxx.MAP files."
- PRINT "For example, the default '\APRS\MAPS\*.MAP' will show all maps in the APRS"
- PRINT "directory. Similarly '*.map' will search your present QB directory."
- PRINT "For any other path, enter the full file specification.": PRINT
- F$ = "\aprs\MAPS\*.map"
- PRINT "Enter Filespec for searching the DIRECTORY ("; F$; ")";
- INPUT a$: IF a$ <> "" THEN F$ = a$
- PRINT : PRINT : FILES F$
- RETURN
-
-
- LoadMap: 'Maps are drawn to the default EGA resolution of 640 x 400 (350)
- Again: GOSUB BoxLine23
- INPUT " Enter map FILENAME, or NEW, or ? for a list, or Q to quit)"; a$
- a$ = UCASE$(a$): IF a$ = "" THEN GOTO Again
- IF a$ = "Q" THEN SYSTEM
- IF a$ = "?" THEN GOSUB MapDIR: GOTO Again
- IF a$ = "NEW" THEN Key$ = "NEW": GOSUB NewMap: RETURN
- a = INSTR(3, a$, "."): IF a = 0 THEN a$ = a$ + ".MAP"
- MapFile$ = a$: F$ = MapFile$: OPEN F$ FOR INPUT AS #3
- IF Fault = 53 THEN Fault = 0: PRINT : CLOSE #3: GOTO Again
- GOSUB BoxLine23: PRINT " Loading "; F$; "..."
- INPUT #3, LATo: LINE INPUT #3, LATtext$
- INPUT #3, LONo: LINE INPUT #3, LONtext$
- INPUT #3, ppdV: LINE INPUT #3, VS$'Pixels per degree horiz
- INPUT #3, LATcen: LINE INPUT #3, LATcen$
- INPUT #3, LONcen: LINE INPUT #3, LONcen$
- INPUT #3, MapRng: LINE INPUT #3, MapRng$
- INPUT #3, MinRng: LINE INPUT #3, MR$
- LINE INPUT #3, TextLine$ ' Line of comments or instrutcitons
- IF LEFT$(TextLine$, 14) = "Map generated " THEN ReDraw = 0
- RS = 2 ^ INT(LOG(MapRng) / LOG(2))'Rng is intgr of VERTrng
- i = 0: LNi = 0:
-
- DO WHILE NOT EOF(3)
- i = i + 1: INPUT #3, x%(i), y: y%(i) = y * Yfactr
- IF x%(i) = 0 AND NOT EOF(3) THEN ' Get line color & store with x=0
- INPUT #3, y%(i): LNi = LNi + 1: LINE INPUT #3, LN$(LNi)' Save line name
- IF y = -1 THEN GOSUB LoadLabels ' All labels listed at end of file
- END IF
- LOOP: nmp = i 'nmp points to 0,-1 that ends all data (but the value
- 'of X% and y% are 0,0 until file is saved.
- LET CDY = LATcen: CDX = LONcen'Center display on ORIGIN
- LET CPX = CDX: CPY = CDY 'Cursor Posn to Center of Display
- LET Z = 2: LnPtr = 1: REM start at first point and first line segment
- CLOSE #3: RETURN: REM first X% value is map color. 2nd val is 1st pt
-
-
-
- LoadLabels: K = 0
- DO WHILE NOT EOF(3)
- K = K + 1: INPUT #3, ML$(K), MLa(K), MLo(K), MLr(K)
- LOOP
- IF MLa(K) = 0 OR MLo(K) = 0 THEN nml = K - 1 ELSE nml = K
- RETURN
-
- SaveMap: GOSUB BoxLine23
- PRINT "Enter file name to save if other than "; MapFile$;
- INPUT a$: IF a$ <> "" THEN MapFile$ = a$
- F$ = MapFile$
- GOSUB BoxLine23: PRINT "Saving map to file named "; F$; " ..."
- OPEN F$ FOR OUTPUT AS #4
- IF Fault = 70 OR Fault = 71 THEN Fault = 0: CLOSE #4: GOTO SaveMap
- PRINT #4, LATo; ","; LATtext$
- PRINT #4, LONo; ","; LONtext$
- PRINT #4, ppdV; ","; VS$
- PRINT #4, LATcen; ","; LATcen$
- PRINT #4, LONcen; ","; LONcen$
- PRINT #4, MapRng; ","; MapRng$
- PRINT #4, MinRng; ","; MR$
- PRINT #4, TextLine$
- j = 1
- FOR i = 1 TO nmp
- IF x%(i) <> 0 THEN WRITE #4, x%(i), INT((y%(i) / Yfactr) + .5)
- IF x%(i) = 0 AND i = nmp THEN PRINT #4, " 0,-1"
- IF x%(i) = 0 AND i <> nmp THEN
- PRINT #4, "0,0"
- PRINT #4, y%(i); ","; LN$(j): j = j + 1
- END IF
- NEXT i
- PRINT #4, "0,"; LN$(LNi)
- FOR K = 1 TO nml
- PRINT #4, ML$(K); ","; : WRITE #4, MLa(K), MLo(K), MLr(K)
- NEXT K: CLOSE #4: LOCATE 24, 1:
- Changed = 0
- IF nmp > MaxNumPoints OR nml > MaxNumLABELS THEN
- CLS : LOCATE 9, 29: PRINT "CAUTION!": PRINT : PRINT
- IF nmp > MaxNumPoints THEN
- PRINT " The number of points,"; nmp; "is greater than"; MaxNumPoints
- END IF
- IF nml > MaxNumLABELS THEN
- PRINT " The number of LABELS,"; nml; "is greater than"; MaxNumLABELS
- END IF
- LOCATE 18, 12
- PRINT " Therefore this map will not work with APRS (yet) "
- LOCATE 23, 1: INPUT "HIT Enter to continue..."; a$
- END IF: GOTO DrwMPaCur
-
- CurDrwMap: CDX = CPX: CDY = CPY: GOTO DrawMap: REM Re-center at CURSOR location
-
- DrwMPaCur: CPX = CDX: CPY = CDY: GOSUB DrawMap
- REM After drawing map, Put cursor at center
- RETURN
-
- DrawMap: IF USGS THEN RETURN
- Display$ = "MAP": COLOR 15, 0
- 'Draw to range scale RS and center display CDX and CDY
- 'Original Map was 40 pix-per-deg Horiz and 20 vert for 200 display
- 'Now ppdH and ppdV are variables. The scaling factor KP is 1 for
- 'the original map scale.
- DO WHILE RS < 320 / ppdV: RS = RS * 2: LOOP
- IF RS > 8192 THEN RS = 8192
- KP = 100 * 100 / (RS * ppdV)'This is to scale it down from the 120 maps
- Sfac = 50 * 200 / RS 'Till 307 had been 100*120
-
- Lfac = COS(CDY / 57.296)
- Hfac = (640 / 350) * (3 / 4) * Lfac
- dx = ppdV * (LONo - CDX)
- dy = ppdV * (LATo - CDY)
-
- CLS : LOCATE 1, 2: PRINT "Redrawing Map"
- REM first put ORIGIN and map CENTER on the map
- LINE (320 - KP * dx, Ycen - KP * dy)-(960 - KP * dx, Ycen - KP * dy), 14
- LINE (320 - KP * dx, Ycen - KP * dy)-(320 - KP * dx, 3 * Ycen - KP * dy), 14
- CMX = 320 + Sfac * (CDX - LONcen) * Hfac'new
- CMY = Ycen + Sfac * (CDY - LATcen) * Yfactr
- LINE (CMX - 27, CMY)-(CMX + 27, CMY), 14
- LINE (CMX, CMY - 20)-(CMX, CMY + 20), 14
- CIRCLE (CMX, CMY), 10, 14
- CIRCLE (320 - KP * dx, Ycen - KP * dy), 12, 14
- s = 0: GOSUB MapPoint: REM Redraw MapPoint
- StrtPt = -1
- DP: FOR i = s TO nmp - 1
- x = 320 + KP * (x%(i) - dx) * Hfac
- y = Ycen + KP * (y%(i) - dy) * Yfactr
- X1 = 320 + KP * (x%(i + 1) - dx) * Hfac
- Y1 = Ycen + KP * (y%(i + 1) - dy) * Yfactr
- IF StrtPt = -1 THEN CIRCLE (x, y), 3, 9: StrtPt = 0
- IF x%(i + 1) <> 0 THEN
- IF RdsOn OR LineColor <> 12 THEN LINE (x, y)-(X1, Y1), LineColor
- IF i = Z THEN SavClr = LineColor
- ELSE
- REM LINE (x - 3, y - 3)-(x + 3, y + 3), 10, B: StrtPt = -1
- CIRCLE (x, y), 5, 10: StrtPt = -1
- LineColor = y%(i + 1): i = i + 1
- IF Display$ = "SHOW" AND LineColor > 8 THEN LineColor = LineColor - 8
- END IF
- NEXT i
- GOSUB Cursor
- GOSUB ReDraw
- REM MapPoint went here
- GOSUB DrawHist: REM draw GPS history track
- IF Display$ = "SHOW" THEN
- GOSUB ShowMaps
- ELSE
- LOCATE 25, 1: PRINT "Use +/- to move MAPpoint. N/P for Next/Previous Feature. H for HELP!.";
- LOCATE 1, 61
- PRINT "POINTS"; nmp; "= "; INT((nmp / MaxNumPoints) * 100); "%";
- LOCATE 2, 61
- PRINT "LABELS "; nml; "= "; INT((nml / MaxNumLABELS) * 100); "%";
- LOCATE 3, 61: PRINT "CENTER "; MID$(STR$(LATcen), 2, 5);
- LOCATE 3, 75: PRINT MID$(STR$(LONcen), 2, 5)
- LOCATE 4, 61: PRINT "SCALE (ppd)"; ppdV
- LOCATE 5, 69: PRINT "Range"; LEFT$(STR$(MapRng), 5)
- END IF
-
- labels:
- IF Labls THEN
- FOR i = 1 TO nml ' Now plot labels on map
- IF RS <= MLr(i) OR Key$ = "S" THEN
- LET x = 320 + Sfac * (CDX - MLo(i)) * Hfac'new
- LET y = Ycen + Sfac * (CDY - MLa(i)) * Yfactr
- IF Tags AND y > 14 * Yfactr AND y < 350 * Yfactr AND x > 8 * (LEN(ML$(i)) + 1) AND x < 632 THEN
- LOCATE y / (14 * Yfactr), (x / 8) - LEN(ML$(i)): PRINT ML$(i);
- END IF
- END IF
- NEXT i
- END IF
- GOSUB ShowMap: RETURN
-
- ShowMap: REM this shows the map boarder of the loaded map
- x = 320 + KP * (CDX - LONcen) * ppdV * Hfac'new
- y = Ycen + KP * (CDY - LATcen) * ppdV * Yfactr
- by = MapRng * Sfac * Yfactr / 60
- bx = by * 640 / (400 * Yfactr) * Lfac'old
- C = 15
- LINE (x - bx, y - by)-(x + bx, y + by), C, B
- RETURN
-
- Cursor: CIRCLE (CUX, CUY), 4, 0
- CUX = 320 + Sfac * (CDX - CPX) * Hfac'new
- CUY = Ycen + Sfac * (CDY - CPY) * Yfactr
- CIRCLE (CUX, CUY), 4, 14
- IF CPX > 0 THEN
- x = INT(CPX): Xm = (CPX - x) * 60
- ELSE x = INT(-CPX): Xm = -(CPX + x) * 60
- END IF
- IF CPY > 0 THEN
- y = INT(CPY): Ym = (CPY - y) * 60
- ELSE y = INT(-CPY): Ym = -(CPY + y) * 60
- END IF
- x$ = RIGHT$(STR$(x), 3) + " "
- LOCATE 1, 2: PRINT "RNG"; RIGHT$(" " + STR$(RS), 4) + " "
- LOCATE 2, 2: PRINT "LAT "; y; MID$(STR$(Ym) + " ", 2, 5)
- LOCATE 3, 2: PRINT "LON "; x$; MID$(STR$(Xm) + " ", 2, 5)
-
- LOCATE 24, 1: PRINT "Cursor coordnts:"; TAB(17);
- PRINT INT(.5 + dx + (CUX - 320) / KP); TAB(23); INT(.5 + dy + (CUY - Ycen) / KP);
- REM LOCATE 24, 55: PRINT "Degrees: ";
- REM PRINT LEFT$(STR$(CPY) + " ", 7); LEFT$(STR$(CPX) + " ", 7);
- LOCATE 1, 16: PRINT "Decimal";
- LOCATE 2, 15: PRINT LEFT$(STR$(CPY) + " ", 8);
- LOCATE 3, 15: PRINT LEFT$(STR$(CPX) + " ", 8);
- LINE (0, 0)-(178, 42 * Yfactr), 12, B'Box around it
- LINE (0, 0)-(116, 42 * Yfactr), 12, B'Box around it
- LET a$ = "": LET B$ = "": RETURN
-
- HELP: CLS : COLOR 15, 1: LINE (0, 0)-(639, 18 * Yfactr), 14, BF
- LOCATE 1, 20: PRINT " MAPFIX.bas HELP SCREEN Ver "; Ver$
- LOCATE 3, 1
-
- PRINT " The cursor is shown in LAT/LON, map offset and decimal degrees. The ORIGIN,"
- PRINT " CENTER and BORDER are shown (but only the CENTER and RANGE in MAPLIST.map are"
- PRINT " actually used by APRS. Labels are right justified to the point just after the"
- PRINT " last letter. CALLS & OBJECT names will be left justified."
- PRINT ""
- PRINT " OPERATIONS MAP FUNCTIONS @N - NEW FEATURE LABEL COMMANDS"
- PRINT " H - HELP SCREENS @C- Change CENTER @A - ADD point S - SHOW labels"
- PRINT " D - map DIRECTORY ^C- Change COLOR @D - DELETE point @L - add a LABEL"
- PRINT "^S - SAVE MAP!!! M - MAPLIST.apr file @K - Kill feature L - LABELS off"
- PRINT " R - RESET pointers O - OTHER map bordrs @M - MOVE point"
- PRINT " Q - QUIT @R- set map RANGE @T - TRIM borders"
- PRINT " "
- PRINT " MAP COMMANDS POINTER MOVEMENTS USGS CD ROM CMDS DIGITIZER & GPS "
- PRINT " SPACE to draw map N - Next Feature B - BOX PPD area @O- OPEN COMMS"
- PRINT " ARROWS (shft) P - Prev Feature U - USGS overlay @B- BEGIN new line"
- PRINT " PgUP/DN (ctrl) G - Go to Pointer T - Test smoother "
- PRINT " HOME to Cursor F - Find point @S- SMOOTH file"
- PRINT " END to map center ^F- Find another @U- USGS BUILD! @G- GPS OVERLAY"
- PRINT " +/- move Pointer @J- JOIN lines"
- PRINT " ^R- REDRAW on/off"
- PRINT : LINE (0, 190 * Yfactr)-(639, 190 * Yfactr), 15
-
- IF Display$ <> "HELP" THEN
- LOCATE 25, 1
- PRINT " HIT H AGAIN FOR MORE HELP SCREENS, OR SPACE BAR FOR MAP...";
- END IF
- Display$ = "HELP"
- LINE (0, 0)-(634, 348 * Yfactr), 15, B
- RETURN
-
-
-
- REM ************* HERE IS THE CODE BROUGHT IN FROM APRS ***************
-
- LdMapLst: GOSUB BoxLine23: INPUT "FileSpec for MAPLIST.apr if not \APRS\MAPLIST.APR"; a$
- IF a$ <> "" THEN F$ = a$ ELSE F$ = "\aprs\Maplist.apr"
- OPEN F$ FOR INPUT AS #3: IF Fault <> 0 THEN RETURN
- i = 1: NumGood = 0
- INPUT #3, DfltY: LINE INPUT #3, a$
- INPUT #3, DfltX: LINE INPUT #3, a$
- INPUT #3, BestRng: LINE INPUT #3, a$: DfltR = BestRng
- INPUT #3, GMToffset: LINE INPUT #3, a$
- WHILE a$ <> "* BEGIN *": LINE INPUT #3, a$: WEND ' Skip comment block
- REM RS = BestRng: REM center display
- REM RS = 2 ^ INT(LOG(RS) / LOG(2))'Rng is intgr power of 2
- REM CPX = CDX: CPY = CDY 'Cursor Posn to Center of Display
- WHILE NOT EOF(3) AND i <= UBOUND(MapName$)
- INPUT #3, MapName$(i), LATcen(i), LONcen(i), MapMax(i)
- LINE INPUT #3, Comment$(i)' IGNORE ALL comment fields
- REM now ignore maps that start with a *
- IF LEFT$(MapName$(i), 1) <> "*" THEN NumGood = NumGood + 1
- NumMaps = i: i = i + 1
- WEND: CLOSE #3
- IF NumGood >= MaxNumMAPS - 1 THEN
- CLS : LOCATE 2, 5
- PRINT "WARNING: Too many ACTIVE MAPS (more than"; MaxNumMAPS; ") in MAPLIST.map file for APRS"
- LOCATE 4, 10: PRINT "Use EDITOR to suppress mapnames with an (*) that you don't need."
- PRINT : PRINT : PRINT : MapListLoaded = -1
- INPUT "HIT RETURN to continue"; a$
- END IF
- RETURN
-
- ListMAPlist: IF NOT MapListLoaded THEN GOSUB LdMapLst
- GOSUB ListHeader
- FOR i = 1 TO NumMaps
- IF i / 19 = INT(i / 19) THEN
- LOCATE 25, 1: PRINT "HIT RETURN to continue"; : INPUT a$
- GOSUB ListHeader
- END IF
- PRINT MapName$(i); TAB(14);
- PRINT INT(LATcen(i) * 100) / 100; TAB(21); INT(LONcen(i) * 100) / 100;
- PRINT TAB(29); MapMax(i); TAB(36); LEFT$(LTRIM$(Comment$(i)), 43)
- NEXT i
-
- LOCATE 25, 1: PRINT "LIST COMPLETE. CONTINUE WITH NEXT MAPFIX COMMAND...";
- RETURN
-
- ListHeader: CLS
- PRINT "MAPS in MAPLIST.map (*MAPS are suppressed) [For now, use EDITOR to modify]"
- PRINT :
- PRINT "MAP NAME LATcen LONcen RANGE COmments"
- PRINT "------------ ------ ------- ----- -------------------------------------------"
- RETURN
-
- DrwAndShow: IF NOT MapListLoaded THEN GOSUB LdMapLst
- Display$ = "SHOW": GOSUB DrwMPaCur
-
- ShowMaps: IF MapSize > RS / 2 THEN MapSize = RS / 2
- LOCATE 25, 1: PRINT " Drawing all maps >"; MapSize;
- PRINT "mi. F3 to see smaller, F4 for bigger, SPACE to cancel.";
- LINE (0, 336 * Yfactr)-(639, 349 * Yfactr), 14, B
- FOR i = 1 TO NumMaps
-
- x = 320 + Sfac * (CDX - LONcen(i)) * Hfac
- y = Ycen + Sfac * (CDY - LATcen(i)) * Yfactr
- dy = MapMax(i) * Sfac * Yfactr / 60
- dx = dy * 640 / (400 * Yfactr) * Lfac
- C = 15
- IF MapMax(i) > 32 THEN C = 14
- IF MapMax(i) > 64 THEN C = 12
- IF MapMax(i) > 128 THEN C = 11
- IF MapMax(i) > 256 THEN C = 13
-
- IF MapMax(i) > MapSize THEN
- LINE (x - dx, y - dy)-(x + dx, y + dy), C, B
- IF y + dy > 14 * Yfactr AND y + dy < 350 * Yfactr THEN
- IF x + dx > 8 * (LEN(MapName$(i)) + 1) AND x + dx < 632 THEN
- LOCATE (y + dy) / (14 * Yfactr), (x + dx) / 8 - LEN(MapName$(i))
- IF MapMax(i) > RS / 4 THEN PRINT MapName$(i);
- END IF
- END IF
- END IF
- NEXT i: RETURN
-
- REM ******* here is the code added by W7KKE for overlyaying track histoiries
- 'This module retrieves GPS history files so you can check the accuracy of
- 'the map
-
- Hstdir: CLS : PRINT "HISTORY FILES DIRECTORY": PRINT
- PRINT "To display HST files, please enter the path to your xxxxxxx.HST files."
- PRINT "For example, the default '\APRS\*.HST' will show all maps in the APRS"
- PRINT "directory. Similarly '*.hst' will search your present QBasic directory."
- PRINT "For any other path, enter the full file specification.": PRINT
-
- PRINT "Enter Filespec for searching the DIRECTORY (\aprs\*.hst)";
- INPUT F$: IF F$ = "" THEN F$ = "\aprs\*.hst"
- IF INSTR(F$, ".") = 0 THEN F$ = F$ + ".HST"
- PRINT : PRINT : FILES F$
- RETURN
-
- LoadHst: GOSUB BoxLine23
- INPUT "Which history file to load (ENTER for list, Q to quit)"; F$
- IF UCASE$(F$) = "Q" THEN RETURN
- IF F$ = "" THEN GOSUB Hstdir: GOTO LoadHst
- a = INSTR(3, F$, "."): IF a = 0 THEN F$ = F$ + ".hst"
- Fault = 0: F$ = UCASE$(F$): OPEN F$ FOR INPUT AS #3
-
- IF Fault = 53 OR Fault = 62 THEN Fault = 0: RETURN
- GOSUB BoxLine23: PRINT "Loading track history from "; F$
-
- DO WHILE NOT EOF(3)
- i = i + 1
- INPUT #3, a$
- HLAT(i) = VAL(MID$(a$, 26, 2)) + (VAL(MID$(a$, 28, 5)) / 60)
- HLONG(i) = VAL(MID$(a$, 35, 3)) + (VAL(MID$(a$, 38, 5)) / 60)
- maxhist = i
- LOOP
- CLOSE #3: Histloaded = -1
- GOSUB BoxLine23: PRINT "File loading is complete. GPS data is plotted."
- REM fall through...
-
- DrawHist: 'put history track on map
- IF Histloaded THEN
- size = 3: IF RS < 2 THEN size = size * 2 / RS
- FOR i = 1 TO maxhist
- HMX = 320 + KP * (CDX - HLONG(i)) * ppdV * Hfac'new
- HMY = Ycen + KP * (CDY - HLAT(i)) * ppdV * Yfactr
- CIRCLE (HMX, HMY), size, 13
- NEXT i
- END IF
- RETURN
-
- NewMap: CLS : PRINT "BEGINNING A NEW MAP FROM SCRATCH...": PRINT
- PRINT "All points in an APRS map are measured as an"
- PRINT "offset to the right and down from an origin."
- PRINT
- INPUT "Enter the LATITUDE of the ORIGIN in degrees , minutes (DD, mm.xx)"; LATo, LAm
- INPUT "Enter the LONGITUDE of the ORIGIN in degrees , minutes (DDD, mm.xx)"; LONo, LOm
- LATo = LATo + LAm / 60
- LONo = LONo + LOm / 60
- PRINT
- PRINT "Choose the number of pixels per degree to set the map scale:"
- PRINT
- PRINT "Approximate size Range from center Pixels/Deg"
- PRINT "---------------- ----------------- ----------"
- PRINT "Big state or region 250 120"
- PRINT "Typical state 100 300"
- PRINT "Several Counties 50 600"
- PRINT "Typical VHF range 25 1200"
- PRINT "City streets (7.5 min maps) 12 2400"
- PRINT
- INPUT "Enter desired Pixels/Deg"; ppdB
- IF ppdB = 0 THEN GOTO NewMap
- REM In following lines, 500 is half of 999 (maximum nominal value for pts)
- LATcen = LATo - (500 * Yfactr / ppdB)
- LONcen = LONo - (500 / ppdB)
- GOSUB StartMap: ppdV = ppdB
- CLS : PRINT "YOU ARE NOW READY TO DRAW A NEW MAP...": PRINT : PRINT
- PRINT "A white border has been drawn around the maximum size permitted for this map"
- PRINT
- PRINT "USING CURSOR WITHOUT DIGITIZER: Move coursor to starting point for a NEW"
- PRINT "feature and hit ALT-N. Then enter new feature name (for reference purposes)"
- PRINT "and continue moving cursor to the next point and hit ALT-A to add more points."
- PRINT "Continue in this fashion, using ALT-N whenever you want to begin a NEW feature."
- PRINT
- PRINT "USING A DIGITIZER: First, use ALT-O once to OPEN the digitizer COM port. Then"
- PRINT "use ALT-B to BEGIN each new map feature. Enter the name and color of the new"
- PRINT "feature. Then use the digitizer mouse to add more points."
- PRINT : PRINT : PRINT
- PRINT "Add LABELS on the map at the current cursor location by using the ALT-L key. "
- PRINT
- PRINT "When you are finished, be sure to SAVE the map using the CTRL-S command..."
- PRINT : PRINT : PRINT
- PRINT "FOR HELP, REMEMBER THE H KEY!"
- PRINT : PRINT : PRINT "Hit ENTER to proceed..."; : INPUT a$
- RETURN
-
- StartMap: REM This called by NEW and in middle of USGS build
- LATcen$ = "LAT of CENTER": LONcen$ = "LON of CENTER"
- MapRng = 60 * 500 * Yfactr / ppdB: REM 500 is half of full map size
- MapRng$ = "Map range from center"
- VS$ = "Pixels per degree"
- MinRng = 1: MR$ = "No longer used"
- TextLine$ = "NEW Map generated by MAPFIX.bas routine..."
- IF Key$ = "NEW" THEN RS = 2 ^ INT(LOG(MapRng) / LOG(2))'Rng is intgr of VERTrng
- CDX = LONcen: CDY = LATcen: CPX = CDX: CPY = CDY
- nmp = 1: nml = 0
- LNi = 1: LN$(1) = "Labels begin here"
- RETURN
-
-
- DigiInit: CLS : PRINT : Digitizer = -1
- PRINT "This routine will replace many CURSOR functions with the Digitizer's MOUSE."
- PRINT "Assuming your digitizer can output an X,Y,C format."
- PRINT
- PRINT "Only Mercator projection charts will give absolutely accurate results. Other"
- PRINT "types, Lambert Conformal, Conical, etc will induce distortions."
- PRINT
- PRINT "It has not been tested with East Longitude or South Latitude."
- PRINT : PRINT
- PRINT "The digitizr should operate at 9600,N,8,1 in POINT mode with 200 LPI resolution."
- PRINT "The FORMAT outputs X,Y,C values separated by commas (C is for button pressed."
- PRINT
- PRINT "Set up the digitizer according to your model's instructions. For the model"
- PRINT "23360, use the drawing board menu by pressing the mouse button 0 on the SETUP"
- PRINT "label so that the LED is ON. Then move the mouse to each other label and"
- PRINT "use the 0 button to toggle the value ON or off as follows:"
- PRINT
- PRINT "POINT is ON PARITY 7/8 and 1 are ON "
- PRINT "BAUDRATE 3 is ON FORMAT is ON ON off ON"
- PRINT "DATA RATE doesn't matter RESOLUTION off off ON"
- PRINT : PRINT
- INPUT "Is DIGITIZER connected to COM1 or COM2 (1)"; a$
- IF a$ <> "2" THEN a$ = "COM1" ELSE a$ = "COM2"
-
- Port$ = a$ + ":9600,N,8,1,cs0,ds0,cd0"
- OPEN Port$ FOR RANDOM AS #1
-
-
- CLS : PRINT "FIRST LETS TEST THE DIGITIZER, AND GET THE MAP ON STRAIGHT.": PRINT
- PRINT "Move your mouse (or pen) and hit the 0 button (or touch tablet) to see if the"
- PRINT "digitizer is outputting in the desired format. While doing this, it is a good"
- PRINT "idea to verify that your map is on straight. The Y values from the mouse"
- PRINT "should give the same values for the same LATITUDE line on both the right and"
- PRINT "left edges of the map. If not, move your map to get it horizontal."
- PRINT
- PRINT "OUTPUT FORMAT:"
- PRINT
- PRINT "XXXXX,YYYYY,APn (Only the X and Y values are used (4 or 5 digits is ok)"
- PRINT
- LOCATE 25, 1: PRINT "Hit ENTER and press 0 button on mouse to continue...";
- LOCATE 13, 1
- DO UNTIL INKEY$ <> "": LINE INPUT #1, a$: PRINT a$: LOOP
-
- CLS : PRINT
- PRINT "NEXT YOU MUST ESTABLISH THE SCALE OF YOUR DIGITIZER."
- PRINT
- PRINT "The scale is established by two points, the first near the"
- PRINT "upper left corner, the second near the lower right corner."
- PRINT
- PRINT "To get the best accuracy on maps not exactly MERCATOR, use points within the "
- PRINT "area where you are working, not on the extreme corners. IE: choose points"
- PRINT "that are in the center of the upper left quadrant and the lower right quadrant."
- PRINT
- PRINT "To establish the upper left reference point:"
- INPUT " Enter lat (deg,min)"; LATref1, M: LATref1 = LATref1 + M / 60
- INPUT " Enter long (deg,min)"; LONref1, M: LONref1 = LONref1 + M / 60
- PRINT
-
- PRINT "Place the mouse on the upper left point and press the 0 button."
- LINE INPUT #1, a$: SOUND 150, 3
- digix1 = 5000 - VAL(LEFT$(a$, 5))
- digiy1 = VAL(MID$(a$, 7, 5))
- PRINT "Digitizer reads "; digix1, digiy1; " for this point.": PRINT
-
- PRINT "NOW Establish the lower right reference point:"
- INPUT " Enter lat (deg,min)"; LATref2, M: LATref2 = LATref2 + M / 60
- INPUT " Enter long (deg,min)"; LONref2, M: LONref2 = LONref2 + M / 60
- PRINT
- PRINT "Place digitizer pen on lower right point."
- LINE INPUT #1, a$: SOUND 150, 3
- digix2 = 5000 - VAL(LEFT$(a$, 5))
- digiy2 = VAL(MID$(a$, 7, 5))
- PRINT "Digitizer reads "; digix2, digiy2; " for this point.": PRINT
-
- REM Find delta lat/long between reference points
- REM Calculate degrees per x/y unit
- degx# = (LONref1 - LONref2) / (digix1 - digix2)
- degy# = (LATref1 - LATref2) / (digiy1 - digiy2)
-
- CLS : PRINT "YOU ARE NOW READY TO USE THE DIGITIZER TO ENTER POINTS INTO MAPFIX..."
- PRINT
- PRINT "The digitizer works just about like the cursor and arrow keys in MAPFIX. Any"
- PRINT "point identified by the digitizer will be ADDED just as if you had hit ALT-A."
- PRINT "All points are added to a feature after the current MapPoint identified by the"
- PRINT "white circle. "
- PRINT
- PRINT "With the digitizer, do NOT use the ALT-N NEW command which always begins at the"
- PRINT "current cursor location. For the digitizer, use ALT-B to BEGIN a new feature."
- PRINT "You will be asked to identify the name and color of the new feature. From then"
- PRINT "on, just move the digitizer mouse (or pen) to ADD new points. "
- PRINT
- PRINT "If your digitizer mouse has 4 buttons, use the first (left) button for ADDing "
- PRINT "points, use the 4th (right) button to just move the cursor with no action."
- PRINT : PRINT
- INPUT "Hit ENTER to continue with MAPFIX..."; a$
- RETURN
-
- GetXY: LINE INPUT #1, a$: SOUND 150, 3
- a = INSTR(a$, ","): IF a = 0 THEN RETURN
- x = 5000 - VAL(LEFT$(a$, a - 1))
- B = INSTR(a + 1, a$, ","): IF B = 0 THEN B = LEN(a$)
- y = VAL(MID$(a$, a + 1, B - (a)))
- Btn = VAL(RIGHT$(a$, 1))
- CPY = ((y - digiy2) * degy#) + LATref2
- CPX = ((x - digix2) * degx#) + LONref2
- IF LOC(1) <> 0 THEN a$ = INPUT$(LOC(1), #1)'Clear input buffer
- RETURN
-
- BoxPPD: GOSUB BoxLine23: INPUT "Enter the desired PPD"; a$
- ppdB = VAL(a$)
- IF ppdB > 1 THEN
- dy = (30000 / ppdB) * Sfac * Yfactr / 60
- dx = dy * 640 / (400 * Yfactr) * Lfac
- GOSUB BoxLine23: LINE (CUX - dx, CUY - dy)-(CUX + dx, CUY + dy), 13, B
- PRINT "The box represents the largest APRS map that can be made with that scale."
- END IF
- RETURN
-
-
- GetUSGS: REM This used for both U=OVERLAY and by ALT-U = USGS BUILD!
- ReDraw = 0: USGS = -1: ni = 0: nt = 0: j = 0: NumLines = 0: LE = 1: OE = 1
- IF Key$ <> "U" THEN
- IF ppdB <> 0 THEN ppdV = ppdB
- IF ppdV < 600 THEN Slope = 1.5 ELSE Slope = 1.2
- SlopeI = 1 / Slope
- LATo = CDY + (500 * Yfactr / ppdV)
- LONo = CDX + (500 / ppdV)
- GOSUB BoxLine23: PRINT "Improve LAT ORIGIN of "; LATo; : INPUT LATo
- GOSUB BoxLine23: PRINT "Improve LON ORIGIN of "; LONo; : INPUT LONo
- GOSUB BoxLine23: INPUT "LATitude extent (100%)"; a$
- IF a$ <> "" THEN LE = VAL(a$) / 100
- GOSUB BoxLine23: INPUT "LONgitude extent (100%)"; a$
- IF a$ <> "" THEN OE = VAL(a$) / 100
- dx = ppdV * (LONo - CDX)
- dy = ppdV * (LATo - CDY)
- KP = 100 * 100 / (RS * ppdV)
- LATcen = CDY: LONcen = CDX: GOSUB StartMap
- LATtext$ = "Decimal LATITUDE of map ORIGIN"
- LONtext$ = "Decimal LONGITUDE of map ORIGIN"
- TextLine$ = "Map generated by MAPFIX from USGS 2,000,000:1 CD ROM (data valid mid-1980's)"
- END IF
- Lmax = 500 + 600 * LE: Lmin = 500 - 600 * LE 'Max=1100 and Min =-100
- Omax = 500 + 600 * OE: Omin = 500 - 600 * OE
- GOSUB BoxLine23: PRINT "Which category (AB,CF,PB,RD,RR,ST,WB) ("; Cat$; ")";
- INPUT a$
- IF a$ <> "" THEN
- a = INSTR(a$, "."): IF a = 0 THEN a$ = a$ + ".GRF"
- Cat$ = a$
- GOSUB BoxLine23: PRINT "Enter path and S??_ to USGS file if not "; Path$;
- INPUT a$
- IF a$ <> "" THEN Path$ = a$
- USGS$ = Path$ + Cat$
- END IF
- TY$ = UCASE$(LEFT$(Cat$, 2))
- LowMax = 99: HiMin = 0
- SELECT CASE TY$
- CASE "RD", "PB", "AB", "CF", "RR": MaxRnk = 99: MinRNk = 0
- CASE "WB": MaxRnk = 20: MinRNk = 0: LowMax = 0: HiMin = 5
- CASE "ST": MaxRnk = 50: MinRNk = 3: LowMax = 16: HiMin = 40
- ' Does not include canals
- ' Make minRNK=7 normal, 10 Alaska, 3 alaska for full map
- END SELECT
- OPEN USGS$ FOR INPUT AS #3
- IF Fault <> 0 THEN RETURN
- REM PRINT "raw data format.....", " LineID", "#-Rnk-Atbts", " NumPts"
- LOCATE 5, 67: PRINT "RANGE: "; INT(30000 / ppdV): LOCATE 24, 1
- IF Key$ = "U" THEN
- PRINT "While USGS OVERLAYED, do not redraw map or you will have to do it again...";
- ELSE PRINT "Blue circles start lines, Green Box ends. Red points discarded, Yellow Kept!";
- END IF
- LOCATE 1, 61: PRINT "TOTAL POINTS: ";
- LOCATE 2, 61: PRINT "POINTS USED: ";
- LOCATE 3, 61: PRINT "TOTAL LINEs: ";
- LOCATE 4, 61: PRINT "LINEs USED: ";
-
- DO UNTIL EOF(3) OR LNi = MaxNumLines - 1
- IF INKEY$ <> "" THEN EXIT DO
- NumLines = NumLines + 1
- LOCATE 1, 75: PRINT nt
- LOCATE 2, 75: PRINT ni
- LOCATE 3, 75: PRINT NumLines
- LOCATE 4, 75: PRINT LNi
- a$ = INPUT$(20, 3): REM PRINT a$;
- LnID$ = LEFT$(a$, 7)
- Rank$ = MID$(a$, 8, 2): Rank = VAL(Rank$): LOCATE 6, 67: PRINT "RANK: "; Rank
- Npts$ = MID$(a$, 10, 6): Npts = VAL(Npts$)
- AtCd$ = MID$(a$, 16, 5)
- a$ = LTRIM$(LnID$) + "-" + Rank$ + "-" + AtCd$
- REM PRINT , LnID$, a$, Npts$
- IF Rank < 24 THEN SavClr = 4 ELSE SavClr = 7
- IF Rank < 20 THEN SavClr = 12
- IF Rank < 14 THEN SavClr = 10
- LineOK = 0: IF Key$ <> "U" THEN GOSUB BeginF
- FOR i = 1 TO Npts
- a$ = INPUT$(20, 3)
- IF Rank > MaxRnk OR Rank < MinRNk THEN IF Rank > 2 OR TY$ <> "ST" THEN GOTO Skp
- IF Rank > LowMax AND Rank < HiMin THEN GOTO Skp
- REM IF VAL(Rank$) > 99 THEN GOTO Skp
- LA = VAL(LEFT$(a$, 2)) + VAL(MID$(a$, 3, 2)) / 60 + VAL(MID$(a$, 5, 2)) / 3600
- LO = VAL(MID$(a$, 8, 3)) + VAL(MID$(a$, 11, 2)) / 60 + VAL(MID$(a$, 13, 2)) / 3600
- IF Key$ = "U" THEN
- REM Following lines used to limit points if just doing an OVERLAY only
- IF LA > CDY + RS / 60 OR LA < CDY - RS / 50 THEN GOTO Skp 'off screen
- IF LO > CDX + RS / (40 * Hfac) OR LO < CDX - RS / (40 * Hfac) THEN GOTO Skp
- REM s$ = MID$(a$, 16, 5)
- REM PRINT S$, LA, LO
- END IF
- y% = (LATo - LA) * ppdV: x% = (LONo - LO) * ppdV
- IF Key$ <> "U" AND (x% > Omax OR x% < Omin) THEN GOTO Skp'this ignores points off PPD
- IF Key$ <> "U" AND (y% > Lmax OR y% < Lmin) THEN GOTO Skp'scale
- LineOK = -1
- X1 = 320 + KP * (x% - dx) * Hfac
- Y1 = Ycen + KP * (y% - dy) * Yfactr
- IF i > 2 THEN
- REM LINE (x, y)-(X1, Y1), 6
- dd = LO - LOb: IF dd = 0 THEN dd = .0000001
- dn = LA - LAb
- s = dn / dd' Note that 1>s>.01 for Xdelta of 1 to 100
- IF ABS(s) < .1 AND ABS(Lsp) < .1 THEN
- sd = 1
- ELSEIF ABS(s) > 10 AND ABS(Lsp) > 10 THEN sd = 1
- ELSEIF ABS(dd) < .004 AND ABS(dn) < .004 THEN sd = 1
- ELSEIF s <> 0 THEN sd = Lsp / s
- ELSE sd = 0
- END IF
- IF sd > Slope OR sd < SlopeI OR i = Npts THEN
- PSET (x, y), 14
- IF Key$ <> "U" THEN GOSUB KeepLine
- ELSE PSET (x, y), 4
- END IF
- Lsp = s: nt = nt + 1
- ELSE Lsp = 0: CIRCLE (X1, Y1), 2, 9
- IF Key$ <> "U" THEN GOSUB KeepLine 'keeps first two lines
- END IF
- LAb = LA: LOb = LO
- x = X1: y = Y1
-
- Skp: NEXT i
- IF Key$ <> "U" THEN
- IF LineOK THEN nmp = nmp - 1: Z = Z - 1: ni = ni + 1 ELSE GOSUB CanclF
- END IF
- LINE (x - 1, y - 1)-(x + 1, y + 1), 10, B ' Last Point
- LOOP
- IF LNi > MaxNumLines - 2 THEN LOCATE 12, 20: PRINT "PROCESSING STOPPED... TOO MANY LLINES!..."
- CLOSE #3
- RETURN
-
- KeepLine: x%(Z) = x%: y%(Z) = y%: nmp = nmp + 1: Z = Z + 1: ni = ni + 1: RETURN
-
-
- Scrunch: i = 0: Pt = 0: nt = 0: ni = 0: GOSUB BoxLine23
- INPUT "Enter slope filter ratio 1.2 to 5 (typically 1.5)"; a$
- IF a$ = "" THEN Slope = 1.5 ELSE Slope = VAL(a$)
- DO UNTIL i >= nmp - 1
- i = i + 1
- X1 = 320 + KP * (x%(i) - dx) * Hfac
- Y1 = Ycen + KP * (y%(i) - dy) * Yfactr
- IF x%(i) <> 0 THEN
- Pt = Pt + 1
- IF Pt > 2 THEN
- LINE (x, y)-(X1, Y1), 6
- dd = x - X1
- dn = y - Y1
- IF dd = 0 AND dn = 0 THEN
- sd = Slope: s = Lsp 'Here the points are identical
- CIRCLE (x, y), 9, 13
- ELSE
- IF dd = 0 THEN dd = .01
- dst = ((dd * dd) + (dn * dn)) ^ .5
- s = dn / dd' Note that 1>s>.01 for Xdelta of 1 to 100
- IF s = 0 THEN s = .05
- IF ABS(s) < .2 THEN s = .2 * SGN(s)
- IF ABS(s) > 5 THEN s = 5 * SGN(s)
- IF ABS(s) <= .2 AND ABS(Lsp) <= .2 THEN
- sd = 1
- ELSEIF ABS(s) >= 5 AND ABS(Lsp) >= 5 THEN sd = 1
- ELSE sd = Lsp / s
- END IF
- IF ABS(dd) > 50 * KP OR ABS(dn) > 30 * KP THEN sd = 0
- REM IF ABS(dd) < 5 OR ABS(dn) < 4 THEN sd = 1
- END IF
- IF sd > Slope OR sd < 1 / Slope OR x%(i + 1) = 0 OR NumRej > 4 THEN
- ni = ni + 1: PSET (x, y), 14: NumRej = 0
-
- ELSE PSET (x, y), 4: NumRej = NumRej + 1
- IF Key$ <> "T" THEN
- i = i - 1: nmp = nmp - 1
- FOR ii = i TO nmp
- x%(ii) = x%(ii + 1): y%(ii) = y%(ii + 1)
- NEXT ii
- END IF
- END IF
- Lsp = s: nt = nt + 1
- ELSE Lsp = 0: nt = nt + 1: ni = ni + 1: CIRCLE (X1, Y1), 4, 9
- END IF
- ELSE Pt = 0: nt = nt + 1: ni = ni + 1
- LOCATE 1, 61: PRINT "TOTAL POINTS: "; nt
- LOCATE 2, 61: PRINT "SAVED POINTS: "; ni
- END IF
- x = X1: y = Y1
- LOOP
- RETURN
-
- Join: REM Search for end=begin point values and CONCATONATE if equal!
- LnPtr = 0: i = 0: K = 0: GOSUB BoxLine23: PRINT "Lines joined: ";
- DO UNTIL i >= nmp
- i = i + 1
- IF x%(i) = x%(i + 2) AND y%(i) = y%(i + 2) AND y%(i + 1) = LColor THEN
- nmp = nmp - 2: LNi = LNi - 1: K = K + 1: LOCATE 23, 15: PRINT K
- FOR j = i + 1 TO nmp: x%(j) = x%(j + 2): y%(j) = y%(j + 2): NEXT j
- FOR j = LnPtr TO LNi: LN$(j) = LN$(j + 1): NEXT j
- ELSEIF x%(i) = 0 THEN LColor = y%(i): LnPtr = LnPtr + 1
- END IF
- LOOP: GOTO DrawMap
-
- END
-
-